home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 081-090 / amok89 / gtb-oberon / demo / fontadapttest.mod < prev    next >
Text File  |  1993-11-04  |  2KB  |  73 lines

  1. (* ------------------------------------------------------------------------
  2.   :Program.       FontAdaptTest
  3.   :Contents.      show how to use GadToolsBox's machine generated source
  4.   :Author.        Kai Bolay [kai]
  5.   :Address.       Snail Mail:              EMail:
  6.   :Address.       Hoffmannstraße 168       UUCP: kai@amokle.stgt.sub.org
  7.   :Address.       D-71229 Leonberg         FIDO: 2:2407/106.3
  8.   :History.       v1.0 [kai] 10-Apr-93 (final cleanup)
  9.   :Copyright.     FD
  10.   :Language.      Oberon
  11.   :Translator.    AMIGA OBERON v3.01d
  12.   :Imports.       FontAdapt (machine generated)
  13. ------------------------------------------------------------------------ *)
  14. MODULE FontAdaptTest;
  15.  
  16. IMPORT
  17.   e: Exec, d: Dos, I: Intuition, gt: GadTools, rq: Requests, fa: FontAdapt;
  18.  
  19. VAR
  20.   quit: BOOLEAN;
  21.  
  22. PROCEDURE HandleMain(): BOOLEAN;
  23. VAR
  24.   imsg: I.IntuiMessagePtr;
  25.   Code: INTEGER;
  26.   Class: LONGSET;
  27.   item: I.MenuItemPtr;
  28.   done: BOOLEAN;
  29. BEGIN
  30.   done := FALSE;
  31.   LOOP
  32.     imsg := gt.GetIMsg (fa.MainWnd.userPort);
  33.     IF imsg = NIL THEN EXIT END;
  34.     (* copy important fields *)
  35.     Class := imsg.class;
  36.     Code := imsg.code;
  37.     gt.ReplyIMsg (imsg); imsg := NIL;
  38.  
  39.     IF (I.menuPick IN Class) THEN
  40.       WHILE Code # I.menuNull DO
  41.         item := I.ItemAddress (fa.MainMenus^, Code);
  42.         IF (I.MenuNum (Code) = 0) AND (I.ItemNum (Code) = 6) THEN
  43.           done := TRUE;
  44.         END;
  45.         Code := item.nextSelect;
  46.       END; (* WHILE *)
  47.     END;
  48.     IF (I.closeWindow IN Class) THEN
  49.       done := TRUE;
  50.     END;
  51.     IF (I.refreshWindow IN Class) THEN
  52.       gt.BeginRefresh (fa.MainWnd);
  53.       fa.MainRender;
  54.       gt.EndRefresh (fa.MainWnd, I.LTRUE);
  55.     END;
  56.   END; (* LOOP *)
  57.   RETURN done;
  58. END HandleMain;
  59.  
  60. BEGIN
  61.   rq.Assert (fa.SetupScreen() = 0, "Unable to set up Screen!");
  62.   rq.Assert (fa.OpenMainWindow(TRUE) = 0, "Unable to open Window");
  63.   quit := FALSE;
  64.   REPEAT
  65.     quit := (d.ctrlC IN e.Wait (LONGSET {fa.MainWnd.userPort.sigBit,
  66.                                          d.ctrlC}));
  67.     quit := quit OR HandleMain();
  68.   UNTIL quit;
  69. CLOSE
  70.   fa.CloseMainWindow;
  71.   fa.CloseDownScreen;
  72. END FontAdaptTest.
  73.